(module interp (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")

  (provide value-of-program value-of)

;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

  ;; value-of-program : program -> expval

  (define value-of-program
    (lambda (pgm)
      (cases program pgm
        (a-program (i-defs modules imports body)
          ;; build an environment from the imports
          (let ((env (initial-env imports modules)))
            (value-of body env)))
        )))

  ;; (list-of sym) * (list-of module-definition) -> environment
  (define initial-env
    (lambda (imports m-defs)
      (if (null? imports)
        (empty-env)
        (extend-env-with-module 
          (car imports)
          (value-of-module
            (lookup-module-in-list (car imports) m-defs)
            m-defs)
          (initial-env (cdr imports) m-defs)))))

  ;; we rely on the typechecker to prevent circular imports.

  ;; module-definition * module-list -> module-value
  (define value-of-module
    (lambda (mdef modules)
      (cases module-definition mdef
        (a-module-definition (name m-type imports m-body)
          (value-of-module-body m-body
            (initial-env imports modules)))) ))

  ;; value-of-module-body : module-body * env -> module-value

  ;; we will have let* scoping inside a module body

  ;; this isn't quite right, because it puts all the values in the
  ;; environment, not just the ones that are in the signature.  But
  ;; the typechecker will prevent anybody from using these.

  (define value-of-module-body
    (lambda (m-body env)
      (cases module-body m-body

        (defns-module-body (defns)
          (env-module-value
            (defns-to-env defns env)))

        (var-module-body (var)
          (lookup-module-in-env var env))

        (proc-module-body (m-var m-type m-body)
          (proc-module-value m-var m-body env))

        (module-app-module-body (rator rand)
          (let ((rator-val (lookup-module-in-env rator env))
                (rand-val (lookup-module-in-env rand env)))
            (cases module-value rator-val
              (proc-module-value (m-var m-body env)
                (value-of-module-body m-body
                  (extend-env-with-module m-var rand-val env)))
              (else (eopl:error 'value-of-module-body 
                      "can't apply non-proc-module-value ~s" rator-val)))))
        )))

  ;; defns-to-env : (list-of definition) * env -> env

  (define defns-to-env
    (lambda (defns env)
      (if (null? defns)
        env
        (cases definition (car defns)
          (val-definition (var exp)
            (let ((val (value-of exp env)))
              (defns-to-env 
                (cdr defns)
                (extend-env var val env))))
          ;; type definitions are ignored at run time
          (else
            (defns-to-env (cdr defns) env))
          ))))


  ;; value-of : expression * environment -> expval

  (define value-of
    (lambda (exp env)

      (cases expression exp

        (const-exp (num) (num-val num))

        (var-exp (var) (apply-env env var))

        (qualified-var-ref (m-name var-name)
          (let ((m-val (lookup-module-in-env m-name env)))
            (cases module-value m-val
              (env-module-value (env)
                (apply-env env var-name))
              (else
                (eopl:error 'value-of 
                  "Attempt to retrieve value from non-basic module ~s"
                  m-val)))))

        (diff-exp (exp1 exp2)
          (let ((val1
		  (expval->num
		    (value-of exp1 env)))
                (val2
		  (expval->num
		    (value-of exp2 env))))
            (num-val
	      (- val1 val2))))
        
        (zero?-exp (exp1)
	  (let ((val1 (expval->num (value-of exp1 env))))
	    (if (zero? val1)
	      (bool-val #t)
	      (bool-val #f))))

        (if-exp (exp0 exp1 exp2) 
          (if (expval->bool (value-of exp0 env))
            (value-of exp1 env)
            (value-of exp2 env)))

        (let-exp (var exp1 body)       
          (let ((val (value-of exp1 env)))
            (let ((new-env (extend-env var val env)))
              (value-of body new-env))))

        (proc-exp (bvar ty body)
	  (proc-val
	    (procedure bvar body env)))

        (call-exp (rator rand)          
          (let ((proc (expval->proc (value-of rator env)))
                (arg  (value-of rand env)))
	    (apply-procedure proc arg)))

        (letrec-exp (ty1 proc-name bvar ty2 proc-body letrec-body)
          (value-of letrec-body
            (extend-env-recursively proc-name bvar proc-body env)))

        )))

  ;; apply-procedure : procedure * expval -> expval

  (define apply-procedure
    (lambda (proc1 arg)
      (cases proc proc1
        (procedure (var body saved-env)
          (value-of body (extend-env var arg saved-env))))))

  )
  


  
